{$MODE FPC}
{$MODESWITCH Result}
{$MODESWITCH Autoderef}
{$MODESWITCH Out}
unit dcreole_html;

interface

uses
  dcreole;

type
TCreoleHtml = object(TCreoleProcess)
protected
  procedure DoOutput(C: AnsiChar); virtual;
  procedure DoOutput(C: WideChar); virtual;
  procedure DoOutput(S: AnsiString); virtual;
  procedure DoOutput(P: PAnsiChar; Count: Integer); virtual;
public
  constructor Init;
  procedure StartParagraph(C: PCreoleParser); virtual;
  procedure FinishParagraph(C: PCreoleParser); virtual;
  procedure Simple(C: PCreoleParser; P: PAnsiChar; Count: Integer); virtual;
  procedure Unformat(C: PCreoleParser; P: PAnsiChar; Count: Integer); virtual;
  procedure StartNowiki(C: PCreoleParser); virtual;
  procedure FinishNowiki(C: PCreoleParser); virtual;
  procedure EndOfLine(C: PCreoleParser); virtual;
  procedure LineBreak(C: PCreoleParser); virtual;
  procedure StartBold(C: PCreoleParser); virtual;
  procedure FinishBold(C: PCreoleParser); virtual;
  procedure StartItalics(C: PCreoleParser); virtual;
  procedure FinishItalics(C: PCreoleParser); virtual;
  procedure StartBulletList(C: PCreoleParser); virtual;
  procedure StartBulletItem(C: PCreoleParser); virtual;
  procedure FinishBulletItem(C: PCreoleParser); virtual;
  procedure FinishBulletList(C: PCreoleParser); virtual;
  procedure StartNumList(C: PCreoleParser); virtual;
  procedure FinishNumList(C: PCreoleParser); virtual;
  procedure StartNumItem(C: PCreoleParser); virtual;
  procedure FinishNumItem(C: PCreoleParser); virtual;
  procedure Link(C: PCreoleParser; Address, Title: String); virtual;
  procedure StartHeading(C: PCreoleParser; Level: Integer); virtual;
  procedure FinishHeading(C: PCreoleParser; Level: Integer); virtual;
  procedure Horizontal(C: PCreoleParser); virtual;
  procedure Image(C: PCreoleParser; Address, Title: String); virtual;
  procedure StartTable(C: PCreoleParser); virtual;
  procedure FinishTable(C: PCreoleParser); virtual;
  procedure StartRow(C: PCreoleParser); virtual;
  procedure FinishRow(C: PCreoleParser); virtual;
  procedure StartCell(C: PCreoleParser); virtual;
  procedure FinishCell(C: PCreoleParser); virtual;
  procedure StartHeadingCell(C: PCreoleParser); virtual;
  procedure FinishHeadingCell(C: PCreoleParser); virtual;
  procedure Plugin(C: PCreoleParser; P: PAnsiChar; Count: Integer); virtual;
end;

implementation

constructor TCreoleHtml.Init;
begin
end;

procedure TCreoleHtml.DoOutput(C: AnsiChar);
begin
  Write(C);
end;

procedure TCreoleHtml.DoOutput(C: WideChar);
begin
  Write(C);
end;

procedure TCreoleHtml.DoOutput(S: AnsiString);
begin
  Write(S);
end;

procedure TCreoleHtml.DoOutput(P: PAnsiChar; Count: Integer);
var
  S: AnsiString;
begin
  // any other ideas?
  if P[Count] <> #0 then begin
    SetLength(S, Count);
    Move(P^, S[1], Count);
    Write(S);
  end else
    Write(P);
end;

procedure TCreoleHtml.StartParagraph(C: PCreoleParser);
begin
  DoOutput('<p>');
end;

procedure TCreoleHtml.FinishParagraph(C: PCreoleParser);
begin
  DoOutput('</p>' + LineEnding);
end;

procedure TCreoleHtml.Simple(C: PCreoleParser; P: PAnsiChar; Count: Integer);
var
  I, J: Integer;
begin
  I := 0;
  while I < Count do begin
    J := I;
    while (J < Count) and not (P[J] in ['<', '>']) do
      Inc(J);
    if J - I > 0 then
      DoOutput(@P[I], J - I);
    // need to save some chars
    if J < Count then
      case P[J] of
        '<': DoOutput('&lt;');
        '>': DoOutput('&gt;');
      else
        // wtf just happened?
        DoOutput('?<!-- strange symbol in input text -->')
      end;
    I := J + 1;
  end;
end;

procedure TCreoleHtml.Unformat(C: PCreoleParser; P: PAnsiChar; Count: Integer);
begin
  DoOutput('<tt>');
  Simple(C, P, Count);
  DoOutput('</tt>');
end;

procedure TCreoleHtml.StartNowiki(C: PCreoleParser);
begin
  DoOutput('<pre>' + LineEnding);
end;

procedure TCreoleHtml.FinishNowiki(C: PCreoleParser);
begin
  DoOutput('</pre>' + LineEnding);
end;

procedure TCreoleHtml.EndOfLine(C: PCreoleParser);
begin
  DoOutput(LineEnding);
end;

procedure TCreoleHtml.LineBreak(C: PCreoleParser);
begin
  DoOutput('<br />' + LineEnding);
end;

procedure TCreoleHtml.StartBold(C: PCreoleParser);
begin
  DoOutput('<strong>');
end;

procedure TCreoleHtml.FinishBold(C: PCreoleParser);
begin
  DoOutput('</strong>');
end;

procedure TCreoleHtml.StartItalics(C: PCreoleParser);
begin
  DoOutput('<em>');
end;

procedure TCreoleHtml.FinishItalics(C: PCreoleParser);
begin
  DoOutput('</em>');
end;

procedure TCreoleHtml.StartBulletList(C: PCreoleParser);
begin
  DoOutput('<ul>');
end;

procedure TCreoleHtml.FinishBulletList(C: PCreoleParser);
begin
  DoOutput('</ul>' + LineEnding);
end;

procedure TCreoleHtml.StartBulletItem(C: PCreoleParser);
begin
  DoOutput('<li>');
end;

procedure TCreoleHtml.FinishBulletItem(C: PCreoleParser);
begin
  DoOutput('</li>' + LineEnding);
end;

procedure TCreoleHtml.StartNumList(C: PCreoleParser);
begin
  DoOutput('<ol>');
end;

procedure TCreoleHtml.FinishNumList(C: PCreoleParser);
begin
  DoOutput('</ol>' + LineEnding);
end;

procedure TCreoleHtml.StartNumItem(C: PCreoleParser);
begin
  // same implementation, don't need to duplicate now
  StartBulletItem(C);
end;

procedure TCreoleHtml.FinishNumItem(C: PCreoleParser);
begin
  FinishBulletItem(C);
end;

procedure TCreoleHtml.Link(C: PCreoleParser; Address, Title: String);
begin
  DoOutput('<a href="' + Address + '">');
  Simple(C, @Title[1], Length(Title));
  DoOutput('</a>');
end;

procedure TCreoleHtml.StartHeading(C: PCreoleParser; Level: Integer);
var
  S: ShortString;
begin
  if (1 <= Level) and (Level <= 6) then begin
    S := '<h0>';
    S[3] := Char(Ord('0') + Level);
    DoOutput(S);
  end else begin
    // bad syntax, do nothing - TCreoleParser concern...
  end;
end;

procedure TCreoleHtml.FinishHeading(C: PCreoleParser; Level: Integer);
var
  S: ShortString;
begin
  if (1 <= Level) and (Level <= 6) then begin
    S := '</h0>' + LineEnding;
    S[4] := Char(Ord('0') + Level);
    DoOutput(S);
  end else begin
    // bad syntax, do nothing - TCreoleParser concern...
  end;
end;

procedure TCreoleHtml.Horizontal(C: PCreoleParser);
begin
  DoOutput('<hr />' + LineEnding);
end;

procedure TCreoleHtml.Image(C: PCreoleParser; Address, Title: String);
begin
  // so simple? :)
  DoOutput('<img src="' + Address + '" alt="' + Title + '" />');
end;

procedure TCreoleHtml.StartTable(C: PCreoleParser);
begin
  DoOutput('<table>' + LineEnding);
end;

procedure TCreoleHtml.FinishTable(C: PCreoleParser);
begin
  DoOutput('</table>' + LineEnding);
end;

procedure TCreoleHtml.StartRow(C: PCreoleParser);
begin
  DoOutput('<tr>' + LineEnding);
end;

procedure TCreoleHtml.FinishRow(C: PCreoleParser);
begin
  DoOutput('</tr>' + LineEnding);
end;

procedure TCreoleHtml.StartCell(C: PCreoleParser);
begin
  DoOutput('<td>');
end;

procedure TCreoleHtml.FinishCell(C: PCreoleParser);
begin
  DoOutput('</td>' + LineEnding);
end;

procedure TCreoleHtml.StartHeadingCell(C: PCreoleParser);
begin
  DoOutput('<th>');
end;

procedure TCreoleHtml.FinishHeadingCell(C: PCreoleParser);
begin
  DoOutput('</th>' + LineEnding);
end;

procedure TCreoleHtml.Plugin(C: PCreoleParser; P: PAnsiChar; Count: Integer);
begin
  DoOutput('<!-- ');
  DoOutput(P, Count);
  DoOutput(' -->');
end;

end.
